Linux Cubed Series 7: Sunsite/Linux Cubed Series 7 - Sunsite Vol 1.iso/system/network/info-sys/www/tkhtml-2.3/tkhtml-2/tkHTML-2.3/tix/bindings/Motif.tcl

Text File | 1995-02-12 | 13.8 KB | 464 lines

# tk.tcl --
#
# Initialization script normally executed in the interpreter for each
# Tk-based application.  Arranges class bindings for widgets.
#
# $Header: /user6/ouster/wish/library/RCS/tk.tcl,v 1.36 93/08/28 16:45:13 ouster Exp $ SPRITE (Berkeley)
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
# CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

# Insist on running with compatible versions of Tcl and Tk.

scan [info tclversion] "%d.%d" a b
if {$a != 7} {
    error "wrong version of Tcl loaded ([info tclversion]): need 7.x"
}
scan $tk_version "%d.%d" a b
if {($a != 3) || ($b < 3)} {
    error "wrong version of Tk loaded ($tk_version): need 3.3 or later"
}
unset a b

# Add Tk's directory to the end of the auto-load search path:

lappend auto_path $tk_library

# Turn off strict Motif look and feel as a default.

set tk_strictMotif 1

# ----------------------------------------------------------------------
# Class bindings for various flavors of button widgets.  $tk_priv(window)
# keeps track of the button containing the mouse $tk_priv(relief) saves
# the original relief of the button so it can be restored when the mouse
# button is released, and $tk_priv(buttonWindow) keeps track of the
# window in which the mouse button was pressed.
# ----------------------------------------------------------------------

bind Button <Any-Enter> {tk_butEnter %W}
bind Button <Any-Leave> {tk_butLeave %W}
bind Button <1> {tk_butDown %W}
bind Button <ButtonRelease-1> {tk_butUp %W}

bind Checkbutton <Any-Enter> {tk_butEnter %W}
bind Checkbutton <Any-Leave> {tk_butLeave %W}
bind Checkbutton <1> {tk_butDown %W}
bind Checkbutton <ButtonRelease-1> {tk_butUp %W}

bind Radiobutton <Any-Enter> {tk_butEnter %W}
bind Radiobutton <Any-Leave> {tk_butLeave %W}
bind Radiobutton <1> {tk_butDown %W}
bind Radiobutton <ButtonRelease-1> {tk_butUp %W}

# ----------------------------------------------------------------------
# Class bindings for entry widgets.
# ----------------------------------------------------------------------
bind Entry <1> {
    if {[catch {%W index sel.first}] == 0} {
    # OWNS SELECTION --> TURN IT OFF
    %W select from end
    %W select to   end
    }
    %W icursor @%x
    %W select from @%x
    if {[lindex [%W config -state] 4] == "normal"} {focus %W}
}
bind Entry <B1-Motion> {
    %W select to @%x
    %W icursor @%x
}
bind Entry <Shift-1> {
    %W select adjust @%x
}
bind Entry <Shift-B1-Motion> {
    %W select to @%x
}
bind Entry <2> {
    catch {
    %W icursor @%x
    %W insert insert [selection get]
    tk_entrySeeCaret %W
    }
}
bind Entry <KeyPress> {
    if {"%A" != ""} {
    if {[catch {%W index sel.first}] == 0} {
        # OWNS SELECTION --> replace it
        %W delete sel.first sel.last
    }
    %W insert insert %A
    tk_entrySeeCaret %W
    }
}
bind Entry <Delete>    {
    if [catch {%W index sel.first}] {
    # DOES NOT OWN SELECTION
    %W delete [%W index insert]
    } else {
    # OWNS SELECTION --> DELETE SELECTION
    %W delete sel.first sel.last
    }
    tk_entrySeeCaret %W
}

bind Entry <Control-d>    {
    if [catch {%W index sel.first}] {
    # DOES NOT OWN SELECTION
    %W delete [%W index insert]
    } else {
    # OWNS SELECTION --> DELETE SELECTION
    %W delete sel.first sel.last
    }
    tk_entrySeeCaret %W
}

bind Entry <BackSpace> {
    if [catch {%W index sel.first}] {
    # DOES NOT OWN SELECTION
    tk_entryBackspace %W
    } else {
    # OWNS SELECTION --> DELETE SELECTION
    %W delete sel.first sel.last
    }
    tk_entrySeeCaret %W
}

bind Entry <Control-h> {
    if [catch {%W index sel.first}] {
    # DOES NOT OWN SELECTION
    tk_entryBackspace %W
    } else {
    # OWNS SELECTION --> DELETE SELECTION
    %W delete sel.first sel.last
    }
    tk_entrySeeCaret %W
}

bind Entry <Right>     {tk_entryMoveCursor %W 1; tk_entrySeeCaret %W}
bind Entry <Control-f> {tk_entryMoveCursor %W 1; tk_entrySeeCaret %W}
bind Entry <Left>      {tk_entryMoveCursor %W -1; tk_entrySeeCaret %W}
bind Entry <Control-b> {tk_entryMoveCursor %W -1; tk_entrySeeCaret %W}
bind Entry <Home>      {%W icursor 0; tk_entrySeeCaret %W}
bind Entry <Control-a> {%W icursor 0; tk_entrySeeCaret %W}
bind Entry <End>       {%W icursor end; tk_entrySeeCaret %W}
bind Entry <Control-e> {%W icursor end; tk_entrySeeCaret %W}
bind Entry <Control-k> {%W delete insert end; tk_entrySeeCaret %W}

tk_bindForTraversal Entry

# ----------------------------------------------------------------------
# Class bindings for listbox widgets.
# ----------------------------------------------------------------------

bind Listbox <1> {%W select from [%W nearest %y]}
bind Listbox <B1-Motion> {%W select to [%W nearest %y]}
bind Listbox <Shift-1> {%W select adjust [%W nearest %y]}
bind Listbox <Shift-B1-Motion> {%W select to [%W nearest %y]}
bind Listbox <2> {%W scan mark %x %y}
bind Listbox <B2-Motion> {%W scan dragto %x %y}

# ----------------------------------------------------------------------
# Class bindings for scrollbar widgets.  When strict Motif is requested,
# the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
# -activeforeground color to -foreground when the mouse is in the window
# and restore it when the mouse leaves.
# ----------------------------------------------------------------------

bind Scrollbar <Any-Enter> {
    if $tk_strictMotif {
    set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
    %W config -activeforeground [lindex [%W config -foreground] 4]
    }
}
bind Scrollbar <Any-Leave> {
    if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
    %W config -activeforeground $tk_priv(activeFg)
    }
}
bind Scrollbar <Any-ButtonPress> {incr tk_priv(buttons)}
bind Scrollbar <Any-ButtonRelease> {incr tk_priv(buttons) -1}

# ----------------------------------------------------------------------
# Class bindings for scale widgets.  When strict Motif is requested,
# the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
# -activeforeground color to -foreground when the mouse is in the window
# and restore it when the mouse leaves.
# ----------------------------------------------------------------------

bind Scale <Any-Enter> {
    if $tk_strictMotif {
    set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
    %W config -activeforeground [lindex [%W config -sliderforeground] 4]
    }
}
bind Scale <Any-Leave> {
    if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
    %W config -activeforeground $tk_priv(activeFg)
    }
}
bind Scale <Any-ButtonPress> {incr tk_priv(buttons)}
bind Scale <Any-ButtonRelease> {incr tk_priv(buttons) -1}

# ----------------------------------------------------------------------
# Class bindings for menubutton widgets.  Variables used:
# $tk_priv(posted) -        keeps track of the menubutton whose menu is
#                currently posted (or empty string, if none).
# $tk_priv(inMenuButton)-    if non-null, identifies menu button
#                containing mouse pointer.
# $tk_priv(relief) -        keeps track of original relief of posted
#                menu button, so it can be restored later.
# $tk_priv(dragging) -        if non-null, identifies menu button whose
#                menu is currently being dragged in a tear-off
#                operation.
# $tk_priv(focus) -        records old focus window so focus can be
#                returned there after keyboard traversal
#                to menu.
# ----------------------------------------------------------------------

bind Menubutton <Any-Enter> {
    set tk_priv(inMenuButton) %W
    if {[lindex [%W config -state] 4] != "disabled"} {
    if {!$tk_strictMotif} {
        %W config -state active
    }
    }
}
bind Menubutton <Any-Leave> {
    set tk_priv(inMenuButton) {}
    if {[lindex [%W config -state] 4] == "active"} {
    %W config -state normal
    }
}
bind Menubutton <1> {tk_mbButtonDown %W}
bind Menubutton <Any-ButtonRelease-1> {
    if {($tk_priv(posted) == "%W") && ($tk_priv(inMenuButton) == "%W")} {
    [lindex [$tk_priv(posted) config -menu] 4] activate 0
    } else {
    tk_mbUnpost
    }
}

# The binding below is trickier than it looks.  It's important to check
# to see that another menu is posted in the "if" statement below.
# The check is needed because some window managers (e.g. mwm in
# click-to-focus mode) cause a button-press event to be preceded by
# a B1-Enter event;  we don't want to process that B1-Enter event (if
# we do, the grab may get mis-set so that the menu is non-responsive).

bind Menubutton <B1-Enter> {
    set tk_priv(inMenuButton) %W
    if {([lindex [%W config -state] 4] != "disabled")
        && ($tk_priv(posted) != "")} {
    if {!$tk_strictMotif} {
        %W config -state active
    }
    tk_mbPost %W
    }
}
bind Menubutton <2> {
    if {($tk_priv(posted) == "")
        && ([lindex [%W config -state] 4] != "disabled")} {
    set tk_priv(dragging) %W
    [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
    }
}
bind Menubutton <B2-Motion> {
    if {$tk_priv(dragging) != ""} {
    [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
    }
}
bind Menubutton <ButtonRelease-2> {set tk_priv(dragging) ""}

# ----------------------------------------------------------------------
# Class bindings for menu widgets.  $tk_priv(x) and $tk_priv(y) are used
# to keep track of the position of the mouse cursor in the menu window
# during dragging of tear-off menus.  $tk_priv(window) keeps track of
# the menu containing the mouse, if any.
# ----------------------------------------------------------------------

bind Menu <Any-Enter> {set tk_priv(window) %W; %W activate @%y}
bind Menu <Any-Leave> {set tk_priv(window) {}; %W activate none}
bind Menu <Any-Motion> {
    if {$tk_priv(window) == "%W"} {
    %W activate @%y
    }
}
bind Menu <1> {
    if {$tk_priv(grab) != ""} {
    grab $tk_priv(grab)
    }
}
bind Menu <ButtonRelease-1> {tk_invokeMenu %W}
bind Menu <2> {set tk_priv(x) %x; set tk_priv(y) %y}
bind Menu <B2-Motion> {
    if {$tk_priv(posted) == ""} {
    %W post [expr %X-$tk_priv(x)] [expr %Y-$tk_priv(y)]
    }
}
bind Menu <B2-Leave> { }
bind Menu <B2-Enter> { }
bind Menu <Escape> {tk_mbUnpost}
bind Menu <Any-KeyPress> {tk_traverseWithinMenu %W %A}
bind Menu <Left> {tk_nextMenu -1}
bind Menu <Right> {tk_nextMenu 1}
bind Menu <Up> {tk_nextMenuEntry -1}
bind Menu <Down> {tk_nextMenuEntry 1}
bind Menu <Return> {tk_invokeMenu %W}

# ----------------------------------------------------------------------
# Class bindings for text widgets. $tk_priv(selectMode) holds one of
# "char", "word", or "line" to indicate which selection mode is active.
# ----------------------------------------------------------------------
bind Text <1> {
    %W tag remove sel 0.0 end
    set tk_priv(selectMode) char
    %W mark set insert @%x,%y
    %W mark set anchor insert
    if {[lindex [%W config -state] 4] == "normal"} {focus %W}
}
bind Text <Double-1> {
    set tk_priv(selectMode) word
    %W mark set insert "@%x,%y wordstart"
    tk_textSelectTo %W insert
}
bind Text <Triple-1> {
    set tk_priv(selectMode) line
    %W mark set insert "@%x,%y linestart"
    tk_textSelectTo %W insert
}
bind Text <B1-Motion> {
    tk_textSelectTo %W @%x,%y
    %W mark set insert @%x,%y
}
bind Text <Shift-1> {
    tk_textResetAnchor %W @%x,%y
    tk_textSelectTo %W @%x,%y
}
bind Text <Shift-B1-Motion> {
    tk_textSelectTo %W @%x,%y
    %W mark set insert @%x,%y
}
bind Text <2> {
    catch {
    %W mark set insert @%x,%y
    %W insert insert [selection get]
    %W mark set insert @%x,%y
    %W yview -pickplace insert
    }
}
bind Text <Left> {
    %W mark set insert insert-1c
    %W yview -pickplace insert
}
bind Text <Right> {
    %W mark set insert insert+1c
    %W yview -pickplace insert
}
bind Text <Up> {
    %W mark set insert insert-1l
    %W yview -pickplace insert
}
bind Text <Down> {
    %W mark set insert insert+1l
    %W yview -pickplace insert
}

# Motif style behavior
bind Text <KeyPress> {
    if {"%A" != ""} {
    catch {
        # owns selection -> delete it
        if {[%W tag ranges sel] != {}} {
        eval %W delete [%W tag ranges sel]
        }
    }
    %W insert insert %A
    %W yview -pickplace insert
    }
}

bind Text <Return> {
    catch {
    if {[%W tag ranges sel] != {}} {
        # owns selection -> delete it
        eval %W delete [%W tag ranges sel]
    }
    }
    %W insert insert \n
    %W yview -pickplace insert
}
bind Text <Delete> {
    if {[%W tag ranges sel] != {}} {
    eval %W delete [%W tag ranges sel]
    } else {
    %W delete insert
    }
    %W yview -pickplace insert
}

bind Text <Control-d> {
    if {[%W tag ranges sel] != {}} {
    eval %W delete [%W tag ranges sel]
    } else {
    %W delete insert
    }
    %W yview -pickplace insert
}

bind Text <BackSpace> {
    if {[%W tag ranges sel] != {}} {
    eval %W delete [%W tag ranges sel]
    } else {
    tk_textBackspace %W
    }
    %W yview -pickplace insert
}

bind Text <Control-h> {
    if {[%W tag ranges sel] != {}} {
    eval %W delete [%W tag ranges sel]
    } else {
    tk_textBackspace %W
    }
    %W yview -pickplace insert
}


tk_bindForTraversal Text

# Initialize the elements of tk_priv that require initialization.

set tk_priv(buttons) 0
set tk_priv(buttonWindow) {}
set tk_priv(dragging) {}
set tk_priv(focus) {}
set tk_priv(grab) {}
set tk_priv(inMenuButton) {}
set tk_priv(posted) {}
set tk_priv(selectMode) char
set tk_priv(window) {}

tixDefaultAutoBind

proc tixSetBinding::Motif {} {
    # Just a dummy to make sure that this file is loaded
}